home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 001a / myhost.zip / MYHOST.ASP < prev    next >
Text File  |  1991-07-08  |  62KB  |  1,995 lines
  1. ; MYHOST - a mini BBS for Procomm Plus
  2. ; greatly modified version of HOST by DataStorm
  3. ; Perry Brickley 07/05/91
  4. ;**************************************************************************
  5. ;#  - - - - - - - - - - - -  SECTIONS IN FILE  - - - - - - - - - - - - -  #
  6. ;#                                                                        #
  7. ;#    A. User defines                                                     #
  8. ;#    B. Internal defines                                                 #
  9. ;#    C. Global data                                                      #
  10. ;#    D. MAIN                                                             #
  11. ;#    E. Setup routines                                                   #
  12. ;#    F. Callback routines                                                #
  13. ;#    G. High level I/O routines                                          #
  14. ;#    H. Miscellaneous routines                                           #
  15. ;#    I. Debug routines                                                   #
  16. ;#                                                                        #
  17. ;#                                                                        #
  18. ;##########################################################################
  19.  
  20.  
  21. ;##########################################################################
  22. ;#                                                                        #
  23. ;#   ╔═══╗                                                                #
  24. ;#   ║ A.║                       USER defines                             #
  25. ;#   ╚═══╝                                                                #
  26. ;#                                                                        #
  27. ;##########################################################################
  28.  
  29. ;define DEBUG        ; Uncomment for debugging
  30. ;--------------------------------------------------------------------
  31.  
  32. define BLACK       0
  33. define BLUE        1
  34. define GREEN       2
  35. define CYAN        3
  36. define RED         4
  37. define MAGENTA     5
  38. define BROWN       6
  39. define LTGREY      7
  40.  
  41. define GREY        8
  42. define LTBLUE      9
  43. define LTGREEN    10
  44. define LTCYAN     11
  45. define LTRED      12
  46. define LTMAGENTA  13
  47. define YELLOW     14
  48. define WHITE      15
  49.  
  50. define UNDERLINE   1
  51. define LTULINE     9
  52.  
  53. define NOBLINK     0
  54. define BLINK     128
  55.  
  56. ;***********************************************************************
  57. ;* Below are the definitions for Boolean variables and special         *
  58. ;* keys.                                                               *
  59. ;*                                                                     *
  60. ;***********************************************************************
  61.  
  62. define TRUE        1
  63. define FALSE       0
  64.  
  65. define F1          0x3B00
  66. define F2          0x3C00
  67. define F3          0x3D00
  68. define F4          0x3E00
  69. define F5          0x3F00
  70. define F6          0x4000
  71. define F7          0x4100
  72. define F8          0x4200
  73. define F9          0x4300
  74. define F10         0x4400
  75. define F11         0x8500
  76. define F12         0x8600
  77.  
  78. define HOME_KEY    0x4700
  79. define END         0x4F00
  80. define PG_UP       0x4900
  81. define PG_DN       0x5100
  82. define INS         0x5200
  83. define DEL         0x5300
  84.  
  85. define CUR_LT      0x4B00
  86. define CUR_RT      0x4D00
  87. define CUR_DN      0x5000
  88. define CUR_UP      0x4800
  89. define ALT_Z       0x2C00
  90.  
  91. define PROCOMMDIR   "C:\PCOM"            ; my procomm directory
  92. define HOSTUSRFILE  "C:\PCOM\PCPLUS.USR" ; User data file
  93. define HOSTDLDIR    "C:\ARC\"            ; Host user accessable files
  94. define HOSTULDIR    "C:\ARC\"            ; Where files uploaded to host go
  95. define HOSTWELCOM   ""  ; String to send as user connects
  96.  
  97. define HOSTPORT     COM2  ; (COM1-COM8)      COM port to use.
  98. define HOSTBAUD     2400  ; (300-115200)     Highest baud rate.
  99. define HOSTCALLOG   ON    ; (ON | OFF)       Log callbacks?
  100. define HOSTCDXFER   YES   ; (YES | NO)       Monitor CD during transfers?
  101. define HOSTUSEDTR   YES   ; (YES | NO)       Use DTR to hangup?
  102. define HOSTHFLOW    OFF   ; (ON | OFF)
  103. define HOSTSFLOW    OFF   ; (ON | OFF)
  104.  
  105. define HOSTAUTOBD   ON    ; (ON | OFF)       Automatically adjust baud rate?
  106. define HOSTCONTYP   MODEM ; (MODEM | DIRECT) Using a modem or a cable?
  107. define HOSTMAXDIAL  3     ; (0-999)          Number of times to try callback.
  108. define HOSTNEWUSR   0     ; (0 | 1)          Let new users transfer files?
  109. define HOSTREMCMD   OFF   ; (ON | OFF)       Allow remote commands?
  110. define HOSTSYSTYP   CLOSED; (OPEN | CLOSED)  Should system allow new users?
  111. define HOSTSHELCD   ON    ; (ON | OFF)       Monitor CD during Shell?
  112. define HOSTTIMOUT   5     ; (0-999)          Minutes inactive before hangup.
  113.  
  114. ;--------------------------------------------------------------------
  115.  
  116. ;##########################################################################
  117. ;#                                                                        #
  118. ;# ╔═══╗                                                                  #
  119. ;# ║ B.║                    INTERNAL DEFINES                              #
  120. ;# ╚═══╝                                                                  #
  121. ;#                                                                        #
  122. ;##########################################################################
  123.  
  124. ;define FALSE 0
  125. ;define TRUE  1
  126.  
  127. define NAMEMAX 30
  128. define PSWDMAX 8
  129.  
  130. define DISP 1
  131. define HIDE 0
  132.  
  133. define FLD_SEP    59 ; semi-colon      ; Field separator
  134.  
  135. define BOXMSG      call _BoxMsg with
  136. define BOXVARI     call _BoxVarI with
  137. define BOXVARS     call _BoxVarS with
  138. define COPYSFLD    call _CopySFld with
  139. define HOSTGETC    call _HostGetC with
  140. define HOSTGETS    call _HostGetS with
  141. define HOSTGETYN   call _HostGetYN
  142. define HOSTGOODBYE call _HostGoodbye
  143. define HOSTHANGUP  call _HostHangup
  144. define HOSTPUTS    call _HostPutS with
  145. define QPAUSE      call _QPause
  146. define SETFAILURE  call _SetFailure
  147. define SETSUCCESS  call _SetSuccess
  148. define XKEYGET     call _XKeyGet with
  149. define TX          transmit
  150. define setvattr    call mkvattr with
  151. define NEWLINE     call _newline
  152. define HOSTCLS     call _hostcls
  153.  
  154. ;##########################################################################
  155. ;#                                                                        #
  156. ;# ╔═══╗                                                                  #
  157. ;# ║ C.║                       GLOBAL DATA                                #
  158. ;# ╚═══╝                                                                  #
  159. ;#                                                                        #
  160. ;##########################################################################
  161.  
  162. string urec,ufirst,ulast,upassword,ucomment,ulevel
  163. string cbnumber, savnum
  164. string mailfrom, maildate, mailfile
  165. string prefix = "70#,"    ; cancel call waiting for callback
  166.                           ; set to "" for no prefix
  167. integer escok=0           ; enable or disable host exit
  168. integer chatdir=0         ; chat mode direction
  169.  
  170. ;##########################################################################
  171. ;#                                                                        #
  172. ;# ╔═══╗                                                                  #
  173. ;# ║ D.║                            MAIN                                  #
  174. ;# ╚═══╝                                                                  #
  175. ;#                                                                        #
  176. ;##########################################################################
  177. proc main
  178.    call setup                 ; Setup port, modem, and variables
  179.    while forever              ;---- TOP OF loop
  180.       if not connected && N9 != F2        ; coming in first time
  181.          HOSTCLS
  182.          N8 = 0               ; call back flag
  183.          call GetUser         ; Wait for someone to login
  184.       else
  185.          SETSUCCESS           ; a return from another script
  186.       endif
  187.       if success              ; If user logged on,
  188.          call domystuff       ; my routines
  189.          HOSTGOODBYE
  190.          HOSTCLS
  191.          TX "ATS0=1^M"
  192.          N9 = 0
  193.       else                    ; else ESC key pressed from user wait
  194.          exitwhile            ;
  195.       endif                   ;
  196.    endwhile
  197. endproc
  198.  
  199. ;##########################################################################
  200. ;#                                                                        #
  201. ;# ╔═══╗                                                                  #
  202. ;# ║ E.║                     SETUP ROUTINES                               #
  203. ;# ╚═══╝                                                                  #
  204. ;#                                                                        #
  205. ;#          (1)  Setup                                                    #
  206. ;#          (2)  SetupPort                                                #
  207. ;#          (3)  SetupVars                                                #
  208. ;#          (4)  SetupModem                                               #
  209. ;#                                                                        #
  210. ;##########################################################################
  211.  
  212. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  213. ;*
  214. ;*         Function:  Setup
  215. ;*
  216. ;*          Purpose:  Initialize procOMM PLUS 2.0 for use as a BBS
  217. ;*
  218. ;*            Input:  None
  219. ;*
  220. ;*           Return:  None
  221. ;*
  222. ;*    Preconditions:  None
  223. ;*
  224. ;*   Postconditions:  The port, modem, and variables are initialized.
  225. ;*
  226. ;*            Notes:
  227. ;*
  228. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  229.  
  230. proc setup
  231. ;   call SetupPort    ; Not needed - procomm does this
  232.    call SetupVars
  233. ;   call SetupModem   ; dito
  234. endproc
  235.  
  236. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  237. ;*
  238. ;*         Function:  SetupPort
  239. ;*
  240. ;*          Purpose:  Initialize the communications port
  241. ;*
  242. ;*            Input:  None
  243. ;*
  244. ;*           Return:  None
  245. ;*
  246. ;*    Preconditions:  None
  247. ;*
  248. ;*   Postconditions:  The port baud rate and line settings are initialized.
  249. ;*
  250. ;*            Notes:
  251. ;*
  252. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  253.  
  254. proc SetupPort
  255.    set port     hostport
  256.    set baud     hostbaud
  257.    set parity   none
  258.    set databits 8
  259.    set stopbits 1
  260. endproc
  261.  
  262. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  263. ;*
  264. ;*         Function:  SetupVars
  265. ;*
  266. ;*          Purpose:  Initialize sytem variables
  267. ;*
  268. ;*            Input:  None
  269. ;*
  270. ;*           Return:  None
  271. ;*
  272. ;*    Preconditions:  None
  273. ;*
  274. ;*   Postconditions:  System variables are inialized.
  275. ;*
  276. ;*            Notes:  Many variables are considered to be 'permanent'.
  277. ;*                    Consequently, they are assumed to be setup correctly
  278. ;*                    and are not set again here.  For example, the modem
  279. ;*                    command strings, the modem connect strings, and the
  280. ;*                    options related to dialing must all be configured
  281. ;*                    permanently before running this script.
  282. ;*
  283. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  284. proc SetupVars
  285.  
  286.    set host autobaud     HOSTAUTOBD    ; Setup host variables using their
  287.    set host connection   HOSTCONTYP    ; definitions at the top of this file
  288.    set host dldir        HOSTDLDIR
  289.    set host message      HOSTWELCOM
  290.    set host newuserlvl   HOSTNEWUSR
  291.    set host systype      HOSTSYSTYP
  292.    set host timeout      HOSTTIMOUT
  293.    set host uldir        HOSTULDIR
  294.    set host shellboot    HOSTSHELCD
  295.  
  296.    set callog            HOSTCALLOG    ; Setup miscellaneous variables using
  297.    set cdinxfer          HOSTCDXFER    ; their definitions at the top
  298.    set dropdtr           HOSTUSEDTR
  299.    set hardflow          HOSTHFLOW
  300.    set modem maxdial     HOSTMAXDIAL
  301.    set remotecmd         HOSTREMCMD
  302.    set softflow          HOSTSFLOW
  303.    set host goodbye      recycle
  304.    set fgets_crlf        off
  305.  
  306.    $ifdef DEBUG                        ; set some variables if debugging:
  307.       set aspdebug on                  ;   Put offsets in error messages
  308.       set rangechk on                  ;         Perform range checking
  309.    $endif
  310.  
  311.    set keys              on            ; We do all keys
  312.    set rxdata            on            ; We do all incoming data
  313.  
  314.    set kermit blockcheck 3             ; Use "3 byte CRC"
  315.    set kermit filetype   binary        ; Use binary kermit
  316.    set kermit packsize   1024          ; Negotiate up to maximum packet size
  317.  
  318.    set zmodem errdetect  crc32         ; Use 32-bit CRC
  319.    set zmodem recvcrash  protect       ; Don't let users overwrite files
  320.    set zmodem sendcrash  negotiate     ; Let user recover his downloads
  321.    set zmodem timestamp  off           ; Stamp files with system date/time
  322.    set zmodem txmethod   streaming     ; Use fastest transmit method
  323. endproc
  324.  
  325. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  326. ;*
  327. ;*         Function:  SetupModem
  328. ;*
  329. ;*          Purpose:  Initialize the modem for use as a host answerer
  330. ;*
  331. ;*            Input:  None
  332. ;*
  333. ;*           Return:  None
  334. ;*
  335. ;*    Preconditions:  The port is setup to communicate with the modem
  336. ;*
  337. ;*   Postconditions:  The modem is ready to be used by host mode.
  338. ;*
  339. ;*            Notes:
  340. ;*
  341. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  342. proc SetupModem
  343. integer i, savetxpace
  344.  
  345.    fetch txpace   savetxpace
  346.    fetch termnorm i
  347.    set txpace 150
  348.  
  349.    atsay 0 0 i "Initializing MODEM."
  350.    locate 0 19
  351.  
  352.    TX "ATS7=255^M"
  353.    QPAUSE
  354.  
  355.    TX "ATV1^M~"
  356.    QPAUSE
  357.  
  358.    TX "ATQ0^M~"
  359.    QPAUSE
  360.  
  361.    TX "ATS11=55^M"
  362.    QPAUSE
  363.  
  364.    TX "ATX4^M"
  365.    QPAUSE
  366.  
  367.    TX "ATM0^M"
  368.    QPAUSE
  369.  
  370. ;   TX "ATS0=1^M"
  371. ;   QPAUSE
  372.  
  373.    HOSTCLS
  374.   ; ...
  375.   ; ...
  376.   ; ...  (Insert other modem settings here)
  377.   ; ...
  378.   ; ...
  379.  
  380.    set txpace savetxpace
  381. endproc
  382.  
  383. ;##########################################################################
  384. ;#                                                                        #
  385. ;# ╔═══╗                                                                  #
  386. ;# ║ F.║                    CALLBACK ROUTINES                             #
  387. ;# ╚═══╝                                                                  #
  388. ;#                                                                        #
  389. ;#          (1) CallBack                                                  #
  390. ;#          (2) CallBackRights                                            #
  391. ;#          (3) WantsCB                                                   #
  392. ;#                                                                        #
  393. ;##########################################################################
  394.  
  395. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  396. ;*
  397. ;*   Function:  CallBack
  398. ;*
  399. ;*    Purpose:  hangup and dial the callback number.
  400. ;*
  401. ;*      Input:  ('cbnumber' contains the number to dial)
  402. ;*
  403. ;*     Return:  Nothing
  404. ;*
  405. ;*      Notes:
  406. ;*
  407. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  408. proc CallBack
  409. string title,usernumber
  410.  
  411.    if connected
  412.       HOSTPUTS "`r`n`r`n hangup now and make sure your modem is set to answer."
  413.       HOSTPUTS "`r`n You will be called back momentarily....`r`n`r`n"
  414.       HOSTHANGUP
  415.       if connected
  416.          return
  417.       endif
  418.    endif
  419.    strcpy usernumber prefix        ; get prefix for dialing (i.e. 70#,)
  420.    strcat usernumber cbnumber
  421.    pause 5
  422.    strfmt title "Calling: %s" S9
  423.    mdial usernumber title
  424.    if connected
  425.       pause 1
  426.       rflush
  427.    endif
  428. endproc
  429.  
  430. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  431. ;*
  432. ;*   Function:  CallBackRights
  433. ;*
  434. ;*    Purpose:  Check .USR comment field for special callBACK string
  435. ;*
  436. ;*      Input:  None
  437. ;*
  438. ;*     return:  success if user has call back rights and 'cbnumber'
  439. ;*              set to the number to be dialed.
  440. ;*              FAILURE if user can't be called back.
  441. ;*
  442. ;*      Notes:
  443. ;*
  444. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  445. proc CallBackRights
  446. integer idx
  447.  
  448.    find ucomment "CALLBACK[" idx
  449.    if found
  450.       idx = idx + 9
  451.       substr cbnumber ucomment idx 79
  452.       find cbnumber "]" idx
  453.       if found
  454.          strpoke cbnumber idx 0
  455.          strcpy savnum cbnumber
  456.          SETSUCCESS
  457.          return
  458.       endif
  459.    endif
  460.    SETFAILURE
  461. endproc
  462.  
  463. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  464. ;*
  465. ;*   Function:  WantsCB
  466. ;*
  467. ;*    Purpose:  Ask user if he wants to be called back.
  468. ;*
  469. ;*      Input:  None
  470. ;*
  471. ;*     return:  success if user wants to be called back
  472. ;*              FAILURE otherwise
  473. ;*
  474. ;*      Notes:  If the user chooses hangup, the disconnect is done here.
  475. ;*
  476. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  477. proc WantsCB
  478. string response, newnum
  479. integer i
  480.  
  481.    scroll 0 0 0 23 79 15
  482.  
  483.    while forever                       ; loop until we break out
  484.       HOSTPUTS "`r`n`r`n Would you like to be called back at "
  485.       HOSTPUTS cbnumber
  486.       HOSTPUTS " ?`r`n"
  487.       HOSTPUTS " Your choice (Y=Yes, C=cancel)? "
  488.       HOSTGETC &response               ; Get a character
  489.       if not success                   ; (If connection lost,
  490.          exitwhile                     ;     break with FAILURE set)
  491.       endif                            ;
  492.       SETFAILURE                       ; Assume not calling back
  493.       strupr response                  ; Convert to upper case
  494.       switch response                  ; What do you want user?
  495.          case "Y"                      ; If 'Y'
  496.             SETSUCCESS                 ;    change assumption
  497.             exitwhile                  ;     and break
  498.             endcase                    ;
  499.          case "C"                      ; If 'C'
  500.             HOSTPUTS "`r`nNew number or CR to cancel: "
  501.             HOSTGETS &newnum 20 DISP   ; see if new number for callback
  502.             strlen newnum i            ; CR only pressed?
  503.             if i == 0                  ; cancel if yes
  504.                strcpy cbnumber savnum  ; make sure org number in place
  505.                SETFAILURE
  506.                exitwhile               ;    break
  507.             endif
  508.             strcpy cbnumber newnum     ; get new number
  509.             loopwhile                  ; verify with user
  510.             endcase                    ;
  511.       endswitch
  512.    endwhile
  513. endproc
  514.  
  515. ;##########################################################################
  516. ;#                                                                        #
  517. ;# ╔═══╗                                                                  #
  518. ;# ║ G.║                 HIGH LEVEL I/O ROUTINES                          #
  519. ;# ╚═══╝                                                                  #
  520. ;#                                                                        #
  521. ;#          (1) GetUser                                                   #
  522. ;#          (2) GetUserName                                               #
  523. ;#          (3) GetUserPswd                                               #
  524. ;#          (4) _HOSTGETs                                                 #
  525. ;#          (5) _HOSTGETYN                                                #
  526. ;#          (6) _HOSTGETC                                                 #
  527. ;#          (7) _HOSTPUTS                                                 #
  528. ;#                                                                        #
  529. ;##########################################################################
  530.  
  531. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  532. ;*
  533. ;*   Function:  GetUser
  534. ;*
  535. ;*    Purpose:  Wait for user to connect and login.
  536. ;*
  537. ;*      Input:  None
  538. ;*
  539. ;*     return:  Script aborts if ESC pressed.  Otherwise, the function
  540. ;*              won't return without a user.
  541. ;*
  542. ;*      Notes:
  543. ;*
  544. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  545. proc GetUser
  546. integer i
  547.  
  548.    statmsg "Waiting for connection (ESC aborts)..."
  549.    TX "ATS0=1^M"
  550.  
  551.    while forever
  552.       if N9 != F2              ; Look for keyhit if not local logon
  553.          if hitkey                  ; Allow ESC key to exit loop
  554.             XKEYGET &N9
  555.          endif
  556.       endif
  557.       if N9 == F2              ; Turn off answer and clear data
  558.          TX "ATS0=0^M"              ; for local logon
  559.          pause 1
  560.          while comdata              ; If data available at port
  561.             comgetc i               ;    get the next character
  562.          endwhile
  563.       endif
  564.       ; The logic here is slightly different than the host mode login code.
  565.       ; Since security is utmost, we won't let hackers know why they are
  566.       ; being disconnected (because of an unknown name or an invalid
  567.       ; password).
  568.  
  569.       if connected || N9 == F2    ; Wait for Carrier Detect or local
  570.          HOSTCLS                         ; clear screen
  571.          statrest                      ; restore status line
  572.          call showintro                ; say hello
  573.          call GetUserName              ; Get the users name
  574.          if success
  575.             call GetUserPswd           ; Get the users password
  576.             if success
  577.                call ParseUsrRec        ; Find and parse user record
  578.                if success              ; If found and parsed:
  579.                   call CallBackRights  ; see if user can be called back
  580.                   if success
  581.                      N8 = 1            ; ok to call back
  582.                   endif
  583.                   call sayhello
  584.                   HOSTPUTS "`r`nCheck for mail...."
  585.                   call ParseMail
  586.                   if success
  587.                      HOSTPUTS "`a    You have new mail!"
  588.                      pause 2
  589.                   else
  590.                      HOSTPUTS "   No mail waiting"
  591.                      pause 2
  592.                   endif
  593.                   SETSUCCESS
  594.                   return               ;    return success
  595.                else
  596.                   call toobad          ; oh, not in password file
  597.                endif
  598.             endif
  599.          endif
  600.          N9 = 0                   ; clear local flag
  601.          N8 = 0
  602.          HOSTHANGUP                    ; get em off
  603.          HOSTCLS
  604.          statmsg "Waiting for a connection (ESC aborts)..."
  605.          TX "ATS0=1^M"                 ; auto answer
  606.       endif
  607.    endwhile
  608. endproc
  609.  
  610. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  611. ;*
  612. ;*   Function:  GetUserName
  613. ;*
  614. ;*    Purpose:  Input a user name
  615. ;*
  616. ;*      Input:  None
  617. ;*
  618. ;*     return:  success if user name obtained
  619. ;*              FAILURE if user not obtained
  620. ;*
  621. ;*      Notes:
  622. ;*
  623. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  624. proc GetUserName
  625. integer i, len, tries
  626.  
  627.  
  628.    tries = 0
  629.    if connected
  630.       pause 1
  631.       rflush
  632.    endif
  633.    while tries < 3
  634.       tries++
  635.       HOSTPUTS "`r`n`r`nFirst name: "
  636.       HOSTGETS &ufirst NAMEMAX DISP       ; Get first (and optionally last)
  637.       if not success                      ; return FAILURE if CD drops
  638.          exitwhile
  639.       endif
  640.       strlen ufirst len                   ; len = length of first name
  641.       if len == 0                         ; If length is zero
  642.          loopwhile                        ;    go to top of loop
  643.       endif
  644.  
  645.       find ufirst " " i                   ; Is there a last name? (SPACE)
  646.       if not found
  647.          find ufirst ";" i                ; (Look for SEMICOLON if no SPACE)
  648.       endif
  649.  
  650.       if found                            ; YES, there is a last name:
  651.          strpoke ufirst i 0               ;   terminate the first name
  652.          i++                              ;   i -> 1st character in last name
  653.          substr ulast ufirst i 80         ;    ulast is last name
  654.       else
  655.          HOSTPUTS "`r`n Last name: "
  656.          HOSTGETS &ulast NAMEMAX DISP     ; Get last name
  657.          if not success                   ; return FAILURE if CD drops
  658.             exitwhile
  659.          endif
  660.  
  661.          strlen ulast len
  662.          if len == 0
  663.             loopwhile
  664.          endif
  665.       endif
  666.  
  667.       strupr ufirst
  668.       strupr ulast
  669.       S9 = ufirst
  670.       strcat S9 " "
  671.       strcat S9 ulast
  672.  
  673.       NEWLINE
  674.       HOSTPUTS S9
  675.       HOSTPUTS "`r`nIs this correct (Y/N)? "
  676.       HOSTGETYN
  677.       if success
  678.          return
  679.       else                             ; if user says NO
  680.          tries--                       ;   don't count it as a try
  681.       endif
  682.    endwhile
  683.    HOSTHANGUP
  684.    SETFAILURE
  685. endproc
  686.  
  687. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  688. ;*
  689. ;*   Function:  GetUserPswd
  690. ;*
  691. ;*    Purpose:  Input a user password
  692. ;*
  693. ;*      Input:  None
  694. ;*
  695. ;*     return:  success if user password obtained
  696. ;*              FAILURE if password not obtained
  697. ;*
  698. ;*      Notes:
  699. ;*
  700. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  701. proc GetUserPswd
  702. integer i, tries
  703.  
  704.    tries = 0
  705.    NEWLINE
  706.    while tries < 3
  707.  
  708.       HOSTPUTS "`r`nPassword: "
  709.       HOSTGETS &upassword PSWDMAX HIDE    ; Get password
  710.       if not success
  711.          exitwhile
  712.       endif
  713.       strlen upassword i
  714.       if i > 0
  715.          strupr upassword
  716.          SETSUCCESS
  717.          return
  718.       endif
  719.       tries++
  720.    endwhile
  721.    HOSTHANGUP
  722.    SETFAILURE
  723. endproc
  724.  
  725. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  726. ;*
  727. ;*   Function:  _HostGetS
  728. ;*
  729. ;*    Purpose:  Input a character string from the port or local keyboard
  730. ;*
  731. ;*      Input:  string parameter for return value
  732. ;*
  733. ;*     return:  If success, string variable contains the string
  734. ;*              FAILURE if connection lost
  735. ;*
  736. ;*      Notes:
  737. ;*
  738. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  739. proc _HostGetS
  740. strparm s
  741. intparm max, dodisp
  742. integer i
  743. string response
  744.  
  745.    strpoke s 0 0
  746.    i = 0
  747.    while forever
  748.       HOSTGETC &response
  749.       if not success
  750.          exitwhile
  751.       endif
  752.       switch response
  753.          case "`x01B"                  ; if user enters ESC
  754.             strpoke s 0 0x1B           ; put it as first char
  755.             SETSUCCESS                 ; and exit
  756.             exitwhile
  757.             endcase
  758.          case "`r"                     ; hit the CR
  759.             SETSUCCESS
  760.             exitwhile
  761.             endcase
  762.          case "`b"                     ; backspace
  763.             if i != 0
  764.                HOSTPUTS response
  765.                i--
  766.                strpoke s i 0
  767.             endif
  768.             endcase
  769.          case " "                      ; This SPACE case must immediately
  770.             if i == 0                  ; precede the default so it will
  771.                loopwhile               ; fall through
  772.             endif
  773.          default
  774.             if i < max
  775.                if dodisp
  776.                   HOSTPUTS response
  777.                else
  778.                   HOSTPUTS "*"
  779.                endif
  780.                strcat s response
  781.                i++
  782.             endif
  783.             endcase
  784.       endswitch
  785.    endwhile
  786. endproc
  787.  
  788. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  789. ;*
  790. ;*   Function:  _HostGetYN
  791. ;*
  792. ;*    Purpose:  Input a "Y" or a "N" response
  793. ;*
  794. ;*      Input:  None
  795. ;*
  796. ;*     return:  success if Yes
  797. ;*              FAILURE if No or connection lost
  798. ;*
  799. ;*      Notes:
  800. ;*
  801. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  802. proc _HostGetYN
  803. string response
  804.  
  805.    while forever
  806.       HOSTGETC &response
  807.       if not success
  808.          return
  809.       endif
  810.       strupr response
  811.       switch response
  812.          case "Y"
  813.             SETSUCCESS
  814.             exitwhile
  815.             endcase
  816.          case "N"
  817.             SETFAILURE
  818.             exitwhile
  819.             endcase
  820.       endswitch
  821.    endwhile
  822.    HOSTPUTS response
  823. endproc
  824.  
  825. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  826. ;*
  827. ;*   Function:  _HostGetC
  828. ;*
  829. ;*    Purpose:  Input a character from the port or local keyboard
  830. ;*
  831. ;*      Input:  string parameter for return value
  832. ;*
  833. ;*     return:  If success, string variable contains the character.
  834. ;*              FAILURE is returned if the connection is lost.
  835. ;*
  836. ;*      Notes:
  837. ;*
  838. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  839. proc _HostGetC
  840. strparm c
  841. integer i
  842. long loop = 36000
  843.  
  844.    SETSUCCESS                          ; hope springs eternal
  845.    while loop != 0                     ; time out for activity
  846.       if hitkey                        ; If a key is pressed
  847.          XKEYGET &i                    ; get the key
  848.          if chatdir == 1               ; user turn in chat mode
  849.             if i != 27                 ; allow esc out of chat
  850.                loopwhile               ; throw away key and continue
  851.             endif
  852.          endif
  853.          if i == F10                   ; back door to chat mode
  854.             chatdir = 3                ; set sysop chat call
  855.             call dochat                ; call chat mode
  856.             i = 13                     ; set CR
  857.             exitwhile                  ; force screen to repaint
  858.          endif
  859.          exitwhile
  860.       endif
  861.       if comdata                       ; If data available at port
  862.          comgetc i                     ; get the next character
  863.          if chatdir == 2               ; sysop turn in chat mode
  864.             loopwhile                  ; throw away key and continue
  865.          endif
  866.          exitwhile
  867.       endif
  868.       loop--
  869.    endwhile
  870.    if N9 != F2
  871.       if not connected                 ; If carrier drops
  872.          SETFAILURE                    ;    set error return code
  873.          return                        ;    and return to caller
  874.       endif
  875.    endif
  876.    if loop == 0
  877.       HOSTPUTS "`a`r`n`r`nHost Time Out....."
  878.       HOSTGOODBYE
  879.       SETFAILURE
  880.       return
  881.    endif
  882.    key2ascii i c
  883.    SETSUCCESS
  884. endproc
  885.  
  886. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  887. ;*
  888. ;*   Function:  _HostPutS
  889. ;*
  890. ;*    Purpose:  Output a string to the port and the local screen
  891. ;*
  892. ;*      Input:  string to output
  893. ;*
  894. ;*     return:  None
  895. ;*
  896. ;*      Notes:
  897. ;*
  898. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  899. proc _HostPutS
  900. strparm s
  901. integer c,idx
  902.  
  903.    if connected         ; don't send to modem unless connected
  904.       transmit s        ; this causes problems if in local mode
  905.    endif
  906.    idx = 0
  907.    strpeek s idx c      ; loop through and write chars to local screen
  908.    while c
  909.       writec c
  910.       idx++
  911.       strpeek s idx c
  912.    endwhile
  913. endproc
  914.  
  915. ;##########################################################################
  916. ;#                                                                        #
  917. ;# ╔═══╗                                                                  #
  918. ;# ║ H.║                  MISCELLANEOUS ROUTINES                          #
  919. ;# ╚═══╝                                                                  #
  920. ;#                                                                        #
  921. ;#          (1) ParseUsrRec                                               #
  922. ;#          (2) _BoxMsg                                                   #
  923. ;#          (3) _CopySFld                                                 #
  924. ;#          (4) _HostHangup                                               #
  925. ;#          (5) _Hostgoodbye                                              #
  926. ;#          (6) _QPause                                                   #
  927. ;#          (7) _SetFailure                                               #
  928. ;#          (8) _SetSuccess                                               #
  929. ;#          (9) _XKeyGet                                                  #
  930. ;#                                                                        #
  931. ;##########################################################################
  932.  
  933. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  934. ;*
  935. ;*   Function:  ParseUsrRec
  936. ;*
  937. ;*    Purpose:  Lookup user in .USR file and parse record into globals
  938. ;*
  939. ;*      Input:  S9 is the name of the user to lookup
  940. ;*
  941. ;*     return:  success if user found and parsed.
  942. ;*              FAILURE if user not found or error parsing record.
  943. ;*
  944. ;*      Notes:  These variables are initialized:
  945. ;*                 N0    - User's access level (0 - 9)
  946. ;*                 ucomment   - User's comment field
  947. ;*                 ufirst     - User's first name
  948. ;*                 ulast      - User's last name
  949. ;*                 S9      - User's full name (first and last)
  950. ;*                 upassword  - User's password
  951. ;*                 urec       - Raw record (terminated with a line feed)
  952. ;*
  953. ;*              .USR record:
  954. ;*                            lastname;firstname;password;n;comment.......
  955. ;*                            (n is the access level {'0','1',or '2'})
  956. ;*
  957. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  958. proc ParseUsrRec
  959. integer i
  960. string tmp, upswd
  961.  
  962.    find S9 " " i                    ; i = index of blank name separator
  963.    strcpy ufirst S9 i               ; copy first name
  964.    i++                              ; i = index of last name
  965.    substr ulast S9 i 79             ; extract last name
  966.    strfmt tmp "%s;%s;" ulast ufirst    ; 'tmp' is what we're looking for
  967.    strlen tmp i                        ; i = length of name part
  968.    fopen 1 HOSTUSRFILE "rt"            ; Try to open user file
  969.    if success                          ; If opened
  970.       while not EOF 1                  ;    loop until end of file
  971.          fgets 1 urec                  ;       Get record
  972.          strcmp urec tmp i             ;       Scan record for user
  973.          if success                    ;       If this is our guy,
  974.             COPYSFLD &upswd urec &i FLD_SEP     ; Copy password
  975.             COPYSFLD &ulevel urec &i FLD_SEP    ; Copy access level
  976.             COPYSFLD &ucomment  urec &i FLD_SEP ; Copy comment
  977.             strcmp upassword upswd     ; valid password ?
  978.             if success
  979.                atoi ulevel N0          ; set user level to universal int
  980.                fclose 1
  981.                SETSUCCESS
  982.                return                           ; exit
  983.             endif
  984.          endif
  985.       endwhile
  986.    else
  987.       BOXMSG "Error opening user file."
  988.    endif
  989.    fclose 1
  990.    SETFAILURE
  991. endproc
  992.  
  993. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  994. ;*
  995. ;*   Function:  _BoxMsg
  996. ;*
  997. ;*    Purpose:  Display a string in a box, wait for a key, restore screen
  998. ;*
  999. ;*      Input:  The string to display
  1000. ;*
  1001. ;*     return:  Nothing
  1002. ;*
  1003. ;*      Notes:  This routine can easily be modified to support multiple
  1004. ;*              line messages.
  1005. ;*
  1006. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1007. define COLOR   112    ; Box color
  1008. define TOPLINE 2      ; Row for top of box
  1009. define HPAD    3      ; Extra space around string (horizontal padding)
  1010. define VPAD    1      ; Extra lines above and below string
  1011.  
  1012. proc _BoxMsg
  1013. strparm s
  1014. integer len,toprow,botrow,leftcol,rightcol,bxkey
  1015.  
  1016.    strlen s len
  1017.    if len < 18
  1018.       len = 18 ; Make sure we have room for Press any key msg
  1019.    endif
  1020.  
  1021.    vidsave 0
  1022.    toprow   = TOPLINE
  1023.    botrow   = toprow + 2 + 2*VPAD
  1024.    leftcol  = (80-len)/2 - (HPAD+1)
  1025.    rightcol = leftcol+len+2*HPAD+1
  1026.    box toprow leftcol botrow rightcol COLOR
  1027.    toprow = toprow + VPAD + 1
  1028.    leftcol = leftcol + HPAD + 1
  1029.    atsay toprow leftcol COLOR s
  1030.  
  1031.    atsay botrow leftcol COLOR " Press any key... "
  1032.    leftcol = leftcol + 17
  1033.    locate botrow leftcol
  1034.  
  1035.    XKEYGET &bxkey              ; get a key
  1036.    SETFAILURE
  1037.    vidrest 0
  1038. endproc
  1039.  
  1040. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1041. ;*
  1042. ;*   Function:  _CopySFld
  1043. ;*
  1044. ;*    Purpose:  Copy a string field (SFLD) from any position within
  1045. ;*              the source string, to the destination string.  Also,
  1046. ;*              increment the index by the length of the field copied.
  1047. ;*
  1048. ;*      Input:  (&destination,source,&index,field_separator)
  1049. ;*
  1050. ;*     return:  destination and int are updated.
  1051. ;*
  1052. ;*      Notes:  Terminates when a field_separator or line feed is encountered.
  1053. ;*              (If neither is encountered, the rest of the field is copied.)
  1054. ;*
  1055. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1056. proc _CopySFld
  1057. strparm dst
  1058. strparm src
  1059. intparm index
  1060. intparm fldsep
  1061. integer newidx
  1062. string  endstr,tmp
  1063.  
  1064.    substr endstr src index 79          ; copy end of string to local var
  1065.    key2ascii fldsep tmp                ; tmp = field separator as a string
  1066.    find endstr tmp newidx              ; see if a separator is in the string
  1067.    if not found                        ; If separator not found:
  1068.       find endstr "\n" newidx          ;    is a line feed in the string?
  1069.       if not found                     ;    If not:
  1070.           strlen endstr newidx         ;       use the whole string
  1071.       endif                            ;
  1072.    endif                               ;
  1073.    strcpy dst endstr newidx            ; copy field
  1074.    index = index + newidx + 1          ; set caller's index
  1075. endproc
  1076.  
  1077. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1078. ;*
  1079. ;*   Function:  _HostHangup
  1080. ;*
  1081. ;*    Purpose:  hangup the modem (try several times)
  1082. ;*
  1083. ;*      Input:  ('cbnumber' contains the number to dial)
  1084. ;*
  1085. ;*     return:  Nothing
  1086. ;*
  1087. ;*      Notes:
  1088. ;*
  1089. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1090. proc _HostHangup
  1091. integer hanguptries=3
  1092.  
  1093.    if not connected
  1094.       return
  1095.    endif
  1096.    while hanguptries--
  1097.       pause 1
  1098.       hangup
  1099.       if not connected
  1100.          exitwhile
  1101.       endif
  1102.    endwhile
  1103.    if connected
  1104.       HOSTPUTS "`r`n`r`nERROR: Unable to hangup.`r`n"
  1105.    endif
  1106. endproc
  1107.  
  1108. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1109. ;*
  1110. ;*   Function:  _HostGoodbye
  1111. ;*
  1112. ;*    Purpose:  Give goodbye message, pause, and hangup line
  1113. ;*
  1114. ;*      Input:  None
  1115. ;*
  1116. ;*     return:  None
  1117. ;*
  1118. ;*      Notes:
  1119. ;*
  1120. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1121. proc _HostGoodbye
  1122.  
  1123.    HOSTPUTS "`r`n`r`n`r`ngoodbye "
  1124.    HOSTPUTS S9
  1125.    HOSTPUTS ".`r`n`r`nThanks for calling!`r`n`r`n"
  1126.    HOSTPUTS "Your logoff time is "
  1127.    HOSTPUTS $TIME0
  1128.    HOSTPUTS " on "
  1129.    HOSTPUTS $DATE
  1130.    HOSTPUTS "`r`n`r`n(Please hangup now)`r`n`r`n`r`n"
  1131.    N9 = 0
  1132.    HOSTHANGUP
  1133. endproc
  1134.  
  1135. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1136. ;*
  1137. ;*         Function:  _QPause
  1138. ;*
  1139. ;*          Purpose:  Pause a little and display a progress dot.
  1140. ;*
  1141. ;*            Input:  None
  1142. ;*
  1143. ;*           return:  None
  1144. ;*
  1145. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1146. proc _QPause
  1147.    termwrt '.'
  1148.    mspause 300
  1149. endproc
  1150.  
  1151. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1152. ;*
  1153. ;*         Function:  _SetFailure
  1154. ;*
  1155. ;*          Purpose:  set FAILURE to TRUE (same as success not TRUE)
  1156. ;*
  1157. ;*            Input:  None
  1158. ;*
  1159. ;*           return:  None
  1160. ;*
  1161. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1162. proc _SetFailure
  1163.    strcmp "X" ""
  1164. endproc
  1165.  
  1166. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1167. ;*
  1168. ;*         Function:  _SetSuccess
  1169. ;*
  1170. ;*          Purpose:  set success to TRUE (same as FAILURE not TRUE)
  1171. ;*
  1172. ;*            Input:  None
  1173. ;*
  1174. ;*           return:  None
  1175. ;*
  1176. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1177. proc _SetSuccess
  1178.    strcmp "" ""
  1179. endproc
  1180.  
  1181. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1182. ;*
  1183. ;*         Function:  _XKeyGet
  1184. ;*
  1185. ;*          Purpose:  Pause until a key is pressed and exit script if ESC
  1186. ;*
  1187. ;*            Input:  None
  1188. ;*
  1189. ;*           return:  None
  1190. ;*
  1191. ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  1192. proc _XKeyGet
  1193. intparm key
  1194.  
  1195.    keyget key
  1196.    if (key==27)
  1197.       if escok
  1198.          return
  1199.       endif
  1200.       message "^M^J^M^JScript Aborted.^M^J"
  1201.       TX "ATS0=0^M"
  1202.       QPAUSE
  1203.       exit
  1204.    endif
  1205.    if (key==0x0E08)                ;    convert backspace
  1206.       key = 8
  1207.    endif
  1208. endproc
  1209.  
  1210. proc showintro
  1211. string displine
  1212.  
  1213.    fopen 0 "myhost.one" "rt"
  1214.    if success
  1215.       while not EOF 0
  1216.          fgets 0 displine
  1217.          HOSTPUTS displine
  1218.          NEWLINE
  1219.       endwhile
  1220.       NEWLINE
  1221.       fclose 0
  1222.    endif
  1223.    SETSUCCESS
  1224. endproc
  1225.  
  1226. proc sayhello
  1227.    HOSTPUTS "`r`n`r`n`Hello "
  1228.    HOSTPUTS S9
  1229.    HOSTPUTS ", glad your back!  Your logon is at "
  1230.    HOSTPUTS $TIME0
  1231.    HOSTPUTS " on "
  1232.    HOSTPUTS $DATE
  1233.    HOSTPUTS "`r`n`r`n"
  1234. endproc
  1235.  
  1236. proc domystuff
  1237. string response
  1238.  
  1239.    while forever                       ; loop until we break out
  1240.       call showmenu with &response
  1241.       if not success                   ; (If connection lost,
  1242.          exitwhile                     ;     break with FAILURE set)
  1243.       endif                            ;
  1244.       strupr response                  ; Convert to upper case
  1245.       HOSTPUTS response
  1246.       switch response                  ; What do you want user?
  1247. ;         case "1"                      ; If '1'
  1248. ;            host                       ; enter host mode
  1249. ;            if not success             ; this is a back door for now
  1250. ;               exitwhile
  1251. ;            endif
  1252. ;            endcase                    ;
  1253.          case "O"                      ; other menu
  1254.             call gamemenu
  1255.             if not success
  1256.                exitwhile
  1257.             endif
  1258.             endcase
  1259.          case "F"
  1260.             chdir "g:\oldzips"
  1261.             call filetransfer
  1262.             if not success
  1263.                exitwhile
  1264.             endif
  1265.             endcase
  1266.          case "M"
  1267.             call mailmenu with &response
  1268.             if not success
  1269.                exitwhile
  1270.             endif
  1271.             switch response
  1272.                case "R"
  1273.                   call ParseMail
  1274.                   if success
  1275.                      call getmail
  1276.                      if not success
  1277.                         exitwhile
  1278.                      endif
  1279.                   else
  1280.                      HOSTPUTS "`r`nYou have no mail"
  1281.                   endif
  1282.                   endcase
  1283.                case "S"
  1284.                   call sendmail
  1285.                   if not success
  1286.                      exitwhile
  1287.                   endif
  1288.                endcase
  1289.             endswitch
  1290.             endcase
  1291.          case "S"                      ; dos shell
  1292.             if N0 > 1                 ; check user level
  1293.                set keys off
  1294.                set rxdata off
  1295.                chdir PROCOMMDIR
  1296.                if N9 == F2
  1297.                   shell
  1298.                else
  1299.                   run "DOORWAY COM2 /S:* /I:DOSWAY /G:ON /V:B^U /C:DOS"
  1300.                endif
  1301.                set keys on
  1302.                set rxdata on
  1303.             else
  1304.                HOSTPUTS "`r`ninvalid selection!!!"
  1305.             endif
  1306.             endcase
  1307.          case "H"
  1308.             call helpme
  1309.             if not success
  1310.                exitwhile
  1311.             endif
  1312.             endcase
  1313.          case "T"
  1314.             call dochat
  1315.             if not success
  1316.                exitwhile
  1317.             endif
  1318.             statrest
  1319.             endcase
  1320.          case "C"                      ; user may want a call back
  1321.             if N8 == 1                 ; make sure user didn't sneak in here
  1322.                call WantsCB            ; make sure
  1323.                if success
  1324.                   call CallBack        ; try to call back
  1325.                   if connected         ; if user on line
  1326.                      loopwhile         ; continue as normal
  1327.                   endif
  1328.                endif
  1329.             endif
  1330.             endcase
  1331.          case "K"
  1332.             if N0 > 8
  1333.                HOSTGOODBYE
  1334.                quit
  1335.             endif
  1336.             endcase
  1337.          case "G"                      ; If 'G'
  1338.             return                     ;    break
  1339.             endcase                    ;
  1340.          default
  1341.             HOSTPUTS "`a"
  1342.             loopwhile
  1343.             endcase                    ;
  1344.       endswitch
  1345.    endwhile
  1346. endproc
  1347.  
  1348. proc showmenu
  1349. strparm response
  1350.  
  1351.    NEWLINE
  1352.    HOSTPUTS "`r`nO) Other Menu"
  1353.    HOSTPUTS "`r`nF) File Transfer"
  1354.    if N0 > 1
  1355.       HOSTPUTS "`r`nS) Dos Shell"
  1356.       HOSTPUTS "`r`nC) Call you back"
  1357.       HOSTPUTS "`r`nM) Mail Box"
  1358.    endif
  1359.    if N0 > 8
  1360.       HOSTPUTS "`r`nK) Quit Procomm Plus (Kill)"
  1361.    endif
  1362.    HOSTPUTS "`r`nT) Talk with SYSOP"
  1363.    HOSTPUTS "`r`nH) Help"
  1364.    HOSTPUTS "`r`nG) Goodbye - Hangup for now"
  1365.    HOSTPUTS "`r`n`r`nSelection: "
  1366.    HOSTGETC &response
  1367. endproc
  1368.  
  1369. proc gamemenu
  1370. string dum
  1371.  
  1372.    NEWLINE
  1373.    HOSTPUTS "`r`nNo games at this time"
  1374.    HOSTPUTS "`r`nPress any key "
  1375.    HOSTGETC &dum
  1376. endproc
  1377.  
  1378. proc toobad
  1379.    HOSTPUTS "`r`n`r`n`a`a`a"
  1380.    HOSTPUTS "`r`nYou are not in the system Log"
  1381.    HOSTPUTS "`r`nTry again or contact me by voice."
  1382.    HOSTPUTS "`a`a"
  1383.    pause 3
  1384. endproc
  1385.  
  1386. proc mailmenu
  1387. strparm response
  1388.  
  1389.    NEWLINE
  1390.    HOSTPUTS "`r`nR) Read mail"
  1391.    HOSTPUTS "`r`nS) Send mail"
  1392.    HOSTPUTS "`r`n`r`nSelection: "
  1393.    HOSTGETC &response
  1394. endproc
  1395.  
  1396. proc transmenu
  1397. strparm response
  1398.  
  1399.    NEWLINE
  1400.    HOSTPUTS "`r`nS) Send a file"
  1401.    HOSTPUTS "`r`nR) Receive a file"
  1402.    HOSTPUTS "`r`nD) View Directory"
  1403.    if N0 > 1
  1404.       HOSTPUTS "`r`nC) Change Directory"
  1405.    endif
  1406.    HOSTPUTS "`r`nE) Exit Menu"
  1407.    HOSTPUTS "`r`n`r`nSelection: "
  1408.    HOSTGETC &response
  1409. endproc
  1410.  
  1411. proc tchoice
  1412. strparm response
  1413.  
  1414.    NEWLINE
  1415.    HOSTPUTS "`r`nX) Xmodem"
  1416.    HOSTPUTS "`r`n Z) Zmodem"
  1417.    HOSTPUTS "`r`n Y) Ymodem"
  1418.    HOSTPUTS "`r`n G) Ymodem-G"
  1419.    HOSTPUTS "`r`n S) Sealink"
  1420.    HOSTPUTS "`r`n A) Ascii"
  1421.    HOSTPUTS "`r`n T) Telink"
  1422.    HOSTPUTS "`r`n C) Cancel"
  1423.    HOSTPUTS "`r`nSelect transfer method "
  1424.    HOSTGETC &response
  1425. endproc   
  1426.  
  1427. proc filetransfer
  1428. string response, curdir, newdirectory
  1429.  
  1430.    while forever
  1431.       call transmenu with &response
  1432.       if not success                   ; (If connection lost,
  1433.          exitwhile                     ;     break with FAILURE set)
  1434.       endif                            ;
  1435.       strupr response                  ; Convert to upper case
  1436.       HOSTPUTS response
  1437.       switch response                  ; What do you want user?
  1438.          case "S"                      ; If '1'
  1439.             call movefile with 0
  1440.             if not success
  1441.                exitwhile
  1442.             endif
  1443.             endcase                    ;
  1444.          case "R"                      ; attempt to call dos game
  1445.             call movefile with 1
  1446.             if not success
  1447.                exitwhile
  1448.             endif
  1449.             endcase
  1450.          case "D"
  1451.             call showdir
  1452.             if not success
  1453.                exitwhile
  1454.             endif
  1455.             endcase
  1456.          case "C"
  1457.             getdir 0 curdir
  1458.             HOSTPUTS "`r`nCurrent directory "
  1459.             HOSTPUTS curdir
  1460.             HOSTPUTS "`r`n"
  1461.             HOSTPUTS "New Directory: "
  1462.             HOSTGETS &newdirectory 60 DISP
  1463.             if not success
  1464.                exitwhile
  1465.             endif
  1466.             chdir newdirectory
  1467.             if not success
  1468.                HOSTPUTS "`r`n`r`n`aInvalid Directory"
  1469.                pause 1
  1470.             endif
  1471.             endcase
  1472.          case "E"                      ; If '3'
  1473.             return                     ;    break
  1474.             endcase                    ;
  1475.          default
  1476.             HOSTPUTS "`a"
  1477.             loopwhile
  1478.             endcase                    ;
  1479.       endswitch
  1480.    endwhile
  1481. endproc
  1482.  
  1483. proc movefile
  1484. intparm xfer
  1485. string choice, fname
  1486. integer i
  1487.  
  1488.    while forever          ; transfer until you get tired
  1489.       if xfer == 0
  1490.          HOSTPUTS "`r`n`r`n(CR to Cancel) File Name you're sending: "
  1491.       else
  1492.          HOSTPUTS "`r`n`r`n(CR to Cancel) File Name you're receiving: "
  1493.       endif
  1494.       HOSTGETS &fname 12 DISP
  1495.       if not success
  1496.          exitwhile
  1497.       endif
  1498.       strlen fname i      ; if only CR hit
  1499.       if i == 0           ; we abort operation
  1500.          return
  1501.       endif
  1502.       if xfer != 0        ; if getting a file
  1503.          isfile fname     ; it needs to be here
  1504.       else
  1505.          SETSUCCESS       ; always ok if sending
  1506.       endif
  1507.       if success
  1508.          call tchoice with &choice
  1509.          if not success                   ; (If connection lost,
  1510.             exitwhile                     ;     break with FAILURE set)
  1511.          endif                            ;
  1512.          strupr choice                    ; Convert to upper case
  1513.          HOSTPUTS choice
  1514.          strcmp choice "C"
  1515.          if not success
  1516.             HOSTPUTS "`r`n`r`nStart your procedure.."
  1517.             pause 1
  1518.          endif
  1519.          switch choice                    ; What do you want user?
  1520.             case "X"                      ; xmodem
  1521.                if xfer == 0
  1522.                   getfile xmodem fname
  1523.                else
  1524.                   sendfile xmodem fname
  1525.                endif
  1526.             endcase
  1527.             case "Z"                      ; zmodem
  1528.                if xfer == 0
  1529.                   getfile zmodem
  1530.                else
  1531.                   sendfile zmodem fname
  1532.                endif
  1533.             endcase
  1534.             case "Y"                      ; ymodem batch
  1535.                if xfer == 0
  1536.                   getfile ymodem
  1537.                else
  1538.                   sendfile ymodem fname
  1539.                endif
  1540.             endcase
  1541.             case "G"                      ; ymodem-g
  1542.                if xfer == 0
  1543.                   getfile ymodemg
  1544.                else
  1545.                   sendfile ymodemg fname
  1546.                endif
  1547.             endcase
  1548.             case "S"                      ; sealink
  1549.                if xfer == 0
  1550.                   getfile sealink
  1551.                else
  1552.                   sendfile sealink fname
  1553.                endif
  1554.                endcase
  1555.             case "A"                      ; ascii (who'd use this ?)
  1556.                if xfer == 0
  1557.                   getfile ascii fname
  1558.                else
  1559.                   sendfile ascii fname
  1560.                endif
  1561.             endcase
  1562.             case "T"                      ; telink
  1563.                if xfer == 0
  1564.                   getfile telink
  1565.                else
  1566.                   sendfile telink fname
  1567.                endif
  1568.             endcase
  1569.             case "C"                      ; cancel - go back
  1570.                return
  1571.             endcase
  1572.             case "default"                ; can't you read???
  1573.                HOSTPUTS "`a"
  1574.                loopwhile
  1575.             endcase
  1576.          endswitch
  1577.       else
  1578.         HOSTPUTS "`r`nFile not found"     ; dummy!!
  1579.       endif
  1580.       while comdata              ; If data available at port
  1581.          comgetc i               ;    get the next character
  1582.       endwhile
  1583.    endwhile
  1584. endproc
  1585.  
  1586. proc showdir
  1587. string response,fname,dirline
  1588. integer linecount=0
  1589. integer another=0
  1590. integer nextcol=0
  1591.  
  1592. HOSTPUTS "`a`r`nPress Q to stop listing.."
  1593. HOSTPUTS "Press any key to begin"
  1594. HOSTGETC &response
  1595. if not success
  1596.    return
  1597. endif
  1598. strupr response
  1599. strcmp response "Q"
  1600. if success
  1601.    return
  1602. endif
  1603. NEWLINE
  1604. findfirst "*.*"
  1605. if found
  1606.    another=1
  1607.    strfmt dirline "%12s  %8u            " $FILENAME $FSIZE
  1608.    nextcol++
  1609. endif
  1610. while another
  1611.    findnext
  1612.    if found
  1613.       strfmt fname "%12s  %8u            " $FILENAME $FSIZE
  1614.       if nextcol > 0
  1615.          strcat dirline fname
  1616.          HOSTPUTS dirline
  1617.          NEWLINE
  1618.          linecount++
  1619.          nextcol=0
  1620.       else
  1621.          strcpy dirline fname
  1622.          nextcol++
  1623.       endif
  1624.       if linecount >= 22
  1625.          HOSTPUTS "`r`nPress any key for more (Q to quit)"
  1626.          HOSTGETC &response
  1627.          if not success
  1628.             return
  1629.          endif
  1630.          strupr response
  1631.          strcmp response "Q"
  1632.          if success
  1633.             return
  1634.          endif
  1635.          NEWLINE
  1636.          linecount=0
  1637.       endif
  1638.    else
  1639.       if nextcol == 0
  1640.          HOSTPUTS dirline
  1641.          NEWLINE
  1642.       endif
  1643.       another=0
  1644.    endif
  1645. endwhile
  1646. HOSTPUTS "`r`nPress any key to return"
  1647. HOSTGETC &response
  1648. endproc
  1649.  
  1650. proc dochat
  1651. string verbage
  1652. integer paging = 30
  1653. integer keykey
  1654.  
  1655. HOSTPUTS "`r`n`r`nPaging SYSOP....30 seconds...."
  1656. HOSTPUTS "Press ESC to cancel"
  1657. escok=1                          ; allow host to press esc with no exit
  1658. if chatdir != 3                  ; regular chat call
  1659.    while paging > 0
  1660.       sound 440 50
  1661.       if comdata
  1662.          comgetc keykey
  1663.          if keykey == 27
  1664.             escok=0              ; reset esc flag
  1665.             SETSUCCESS
  1666.             return
  1667.          endif
  1668.       endif
  1669.       if hitkey                  ; Allow ESC key to exit loop
  1670.          XKEYGET &keykey
  1671.          exitwhile
  1672.       endif
  1673.    endwhile
  1674.    if paging < 0
  1675.       HOSTPUTS "`r`nSYSOP not available`r`n"
  1676.       escok=0         ; reflag esc key for host
  1677.       SETSUCCESS
  1678.       return
  1679.    endif
  1680.    HOSTPUTS "`a`r`n`r`nSYSOP waiting`r`n`r`n"
  1681.    chatdir = 1                 ; set user's turn to talk
  1682. endif
  1683. while forever
  1684.    if chatdir == 3             ; if call came from sysop
  1685.       HOSTPUTS "`a`a"          ; signal user
  1686.       chatdir = 2              ; set sysop turn
  1687.    endif
  1688.    if chatdir == 2
  1689.       HOSTPUTS "`r`nSYSOP:`r`n" ; let user know sysop talking
  1690.    else
  1691.       HOSTPUTS "`r`nUSER:`r`n" ; let user know it's his turn
  1692.    endif
  1693.    HOSTGETS &verbage 80 DISP   ; get users message
  1694.    NEWLINE                     ; send \n
  1695.    if not success
  1696.       return
  1697.    endif
  1698.    strpeek verbage 0 keykey    ; check for ESC
  1699.    if keykey == 27             ; if sent
  1700.       escok=0                  ; reflag esc key for host script exit
  1701.       chatdir = 0              ; allow all key strokes
  1702.       SETSUCCESS               ; exit chat
  1703.       return
  1704.    endif
  1705.    if chatdir == 2             ; if sysop talked
  1706.       chatdir = 1              ; it's user's turn
  1707.    else                        ; else
  1708.       chatdir = 2              ; it's sysop's turn
  1709.    endif
  1710. endwhile
  1711. endproc
  1712.  
  1713. proc mkvattr
  1714. intparm attrvar, foreground, background, blinking
  1715.    attrvar = (background << 4) | foreground | blinking
  1716. endproc
  1717.  
  1718. proc helpme
  1719. string helpline, response
  1720. integer haltme
  1721.  
  1722.    fopen 1 "help.dat" "rt"
  1723.    if not success
  1724.       HOSTPUTS "`r`nHelp file not found`r`n"
  1725.       pause 2
  1726.       SETSUCCESS
  1727.       return
  1728.    endif
  1729.    HOSTPUTS "`r`n`r`n"
  1730.    while not EOF 1
  1731.       fgets 1 helpline
  1732.       strpeek helpline 0 haltme
  1733.       if haltme == FLD_SEP
  1734.          HOSTPUTS "Press any key to continue, Q to quit"
  1735.          HOSTGETC &response
  1736.          if not success
  1737.             return
  1738.          endif
  1739.          strupr response
  1740.          strcmp response "Q"
  1741.          if success
  1742.             fclose 1
  1743.             SETSUCCESS
  1744.             return
  1745.          endif
  1746.       HOSTPUTS "`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b"
  1747.       HOSTPUTS "`b`b`b`b`b`b"
  1748.       loopwhile
  1749.       endif
  1750.       HOSTPUTS helpline
  1751.       NEWLINE
  1752.    endwhile
  1753.    HOSTPUTS "Press any key to return (END OF HELP)"
  1754.    HOSTGETC &response
  1755.    if not success
  1756.       return
  1757.    endif
  1758.    NEWLINE
  1759.    fclose 1
  1760.    SETSUCCESS
  1761. endproc
  1762.  
  1763. proc ParseMail
  1764. integer i
  1765. string tmp
  1766.  
  1767.    find S9 " " i                    ; i = index of blank name separator
  1768.    strcpy ufirst S9 i               ; copy first name
  1769.    i++                              ; i = index of last name
  1770.    substr ulast S9 i 79             ; extract last name
  1771.    strfmt tmp "%s %s;" ufirst ulast    ; 'tmp' is what we're looking for
  1772.    strlen tmp i                        ; i = length of name part
  1773.    fopen 1 "hostmail.hdr" "rt"           ; Try to open user file
  1774.    if success                          ; If opened
  1775.       while not EOF 1                  ;    loop until end of file
  1776.          fgets 1 urec                  ;       Get record
  1777.          strcmp urec tmp i             ;       Scan record for user
  1778.          if success                    ;       If this is our guy,
  1779.             fclose 1
  1780.             SETSUCCESS
  1781.             return                      ; exit
  1782.          endif
  1783.       endwhile
  1784.    endif
  1785.    SETFAILURE
  1786. endproc
  1787.  
  1788. proc getmail
  1789. integer i, sequence=1
  1790. integer delflag, index
  1791. string tmp, moveit
  1792.  
  1793.    find S9 " " i                    ; i = index of blank name separator
  1794.    strcpy ufirst S9 i               ; copy first name
  1795.    i++                              ; i = index of last name
  1796.    substr ulast S9 i 79             ; extract last name
  1797.    strfmt tmp "%s %s;" ufirst ulast    ; 'tmp' is what we're looking for
  1798.    fopen 0 "hostmail.hdr" "rt"         ; Try to open user file
  1799.    if success                          ; If opened
  1800.       while not EOF 0                  ;    loop until end of file
  1801.          strlen tmp i                  ; i = length of name part
  1802.          fgets 0 urec                  ;       Get record
  1803.          strcmp urec tmp i             ;       Scan record for user
  1804.          if success                    ;       If this is our guy,
  1805.             COPYSFLD &mailfrom urec &i FLD_SEP  ; Copy from name
  1806.             COPYSFLD &maildate urec &i FLD_SEP  ; Copy mail date
  1807.             COPYSFLD &mailfile urec &i FLD_SEP  ; Copy mail file
  1808.             delflag = 0
  1809.             call showmail with sequence, &delflag
  1810.             if delflag                 ; ok this is kinda messy
  1811.                fopen 2 "tempfile" "wt"
  1812.                fseek 0 0 0             ; go to beginning of file
  1813.                index = 1
  1814.                while not EOF 0
  1815.                   fgets 0 moveit       ; get next record
  1816.                   if index != sequence ; is this the one deleted
  1817.                      fputs 2 moveit    ; if not put it in new file
  1818.                   endif
  1819.                   index++              ; next record number
  1820.                endwhile
  1821.                fclose 0                ; close files
  1822.                fclose 2
  1823.                delete "hostmail.hdr"   ; delete current file
  1824.                rename "tempfile" "hostmail.hdr" ; make new file the header
  1825.                fopen 0 "hostmail.hdr" "rt"  ; open header file
  1826.                index = 1               ; reset index
  1827.                while index != sequence ; find next record to read
  1828.                   fgets 0 moveit
  1829.                   index++
  1830.                endwhile
  1831.                HOSTPUTS "`amessage deleted"
  1832.                loopwhile
  1833.             endif
  1834.          sequence++
  1835.          endif
  1836.       endwhile
  1837.    else
  1838.       BOXMSG "Error opening user file."
  1839.    endif
  1840.    fclose 0
  1841.    SETSUCCESS
  1842. endproc
  1843.  
  1844. proc showmail
  1845. intparm sequence, delflag
  1846. string mailline, msgnum
  1847.  
  1848.    fopen 1 mailfile "rt"
  1849.    if not success
  1850.       HOSTPUTS "`r`n`r`nError opening mail file -> "
  1851.       HOSTPUTS mailfile
  1852.       NEWLINE
  1853.       pause 2
  1854.       return
  1855.    endif
  1856.    strfmt msgnum "Message number: %d`r`n" sequence
  1857.    HOSTPUTS "`r`n`r`n"
  1858.    HOSTPUTS msgnum
  1859.    HOSTPUTS "From : "
  1860.    HOSTPUTS mailfrom
  1861.    NEWLINE
  1862.    HOSTPUTS "Date : "
  1863.    HOSTPUTS maildate
  1864.    HOSTPUTS "`r`n`r`n"
  1865.    while not EOF 1
  1866.       fgets 1 mailline
  1867.       HOSTPUTS mailline
  1868.       NEWLINE
  1869.    endwhile
  1870.    fclose 1
  1871.    HOSTPUTS "End of Message   (Delete Y/N) "
  1872.    HOSTGETYN
  1873.    if success
  1874.       delflag = 1
  1875.       delete mailfile
  1876.    endif
  1877.    NEWLINE
  1878.    SETSUCCESS
  1879. endproc
  1880.  
  1881. proc sendmail
  1882. string sendto, msgline, filename, part1, part2, part3, part4
  1883. integer len
  1884. integer index=1
  1885.  
  1886.    HOSTPUTS "`r`none moment....."
  1887.    substr part1 $date 6 2
  1888.    substr part2 $date 3 2
  1889.    substr part3 $date 0 2
  1890.    part4 = "00"
  1891.    filename = part1
  1892.    strcat filename part2
  1893.    strcat filename part3
  1894.    strcat filename part4
  1895.    strcat filename ".mal"
  1896.    while forever
  1897.       isfile filename
  1898.       if success
  1899.          itoa index part4
  1900.          strlen part4 len
  1901.          if len == 1
  1902.             strupdt filename part4 7 len
  1903.          else
  1904.             strupdt filename part4 6 len
  1905.          endif
  1906.       else
  1907.          exitwhile
  1908.       endif
  1909.       index++
  1910.       if index > 99
  1911.          HOSTPUTS "`r`nmsgline limit exceeded`a`r`n"
  1912.          SETSUCCESS
  1913.          return
  1914.       endif
  1915.    endwhile
  1916.    fopen 0 filename "wt"
  1917.    fopen 1 "hostmail.hdr" "a"
  1918.    if not success
  1919.       fopen 1 "hostmail.hdr" "wt"
  1920.    endif
  1921.    escok=1
  1922.    HOSTPUTS "`r`nYou may press ESC at anytime to exit this routine`r`n`r`n"
  1923.    HOSTPUTS "`r`n`r`nMessgae to: "
  1924.    HOSTGETS &sendto 80 DISP
  1925.    call checkesc with sendto
  1926.    if success
  1927.       fclose 0
  1928.       fclose 1
  1929.       delete filename
  1930.       escok=0
  1931.       SETSUCCESS
  1932.       return
  1933.    endif
  1934.    strupr sendto
  1935.    strlen sendto len
  1936.    for index=1 upto len
  1937.       HOSTPUTS "`b"
  1938.    endfor
  1939.    HOSTPUTS sendto
  1940.    NEWLINE
  1941.    strfmt part1 "%s;%s;%s;%s`n" sendto,S9,$DATE,filename
  1942.    index = 1
  1943.    while forever
  1944.       strfmt part2 "%d: " index
  1945.       HOSTPUTS part2
  1946.       HOSTGETS &msgline 76 DISP
  1947.       call checkesc with msgline
  1948.       if success
  1949.          strfmt part3 "`r`nSend this message to %s (Y/N) " sendto
  1950.          HOSTPUTS part3
  1951.          HOSTGETYN
  1952.          if success
  1953.             fputs 1 part1
  1954.             fclose 1
  1955.             fclose 0
  1956.             HOSTPUTS "`r`nmessage sent"
  1957.             escok=0
  1958.             SETSUCCESS
  1959.             return
  1960.          endif
  1961.       else
  1962.          strcat msgline "`n"
  1963.          fputs 0 msgline
  1964.          NEWLINE
  1965.       endif
  1966.       index++
  1967.    endwhile
  1968. endproc
  1969.  
  1970. proc checkesc
  1971. strparm astring
  1972. integer isesc
  1973.  
  1974.    strpeek astring 0 isesc
  1975.    if isesc == 27
  1976.       SETSUCCESS
  1977.    else
  1978.       SETFAILURE
  1979.    endif
  1980. endproc
  1981.  
  1982. proc _newline
  1983.    HOSTPUTS "`r`n"
  1984. endproc
  1985.  
  1986. proc _hostcls
  1987. integer loop
  1988.  
  1989.    for loop=0 upto 25
  1990.       HOSTPUTS "`n"
  1991.    endfor
  1992.    HOSTPUTS "`r"
  1993. endproc
  1994.  
  1995.